library(corrplot)
library(corrgram)
library(skimr)
library(knitr)
library(ggplot2)
library(dplyr)
library(formattable)
library(randomForest)
library(caret)
library(readr)
library(gmodels)
library(rpart)
library(rpart.plot)
library(polycor)
library(cluster)
library(fpc)
library(readxl)Esta analise visa utilizar o dataset disponivel e mensurar a variavel salarios com base em algumas variaveis, como: sexo, idade, tamanho da empresa e outros.
salarios <- read_excel(path = './salario_1.xlsx', sheet = 1);
salarios$sexo <- factor(salarios$sexo);
salarios## # A tibble: 654 x 7
## id salario sexo tempoempresa idade escolaridade experiencia
## <dbl> <dbl> <fct> <dbl> <dbl> <dbl> <dbl>
## 1 100 1501 Masculino 24 18 12 13
## 2 123 2538 Feminino 23 18 11 5.25
## 3 173 1750 Feminino 72 20 12 4.42
## 4 223 5501 Feminino 25 20 7 1.67
## 5 273 4000 Feminino 22 21 8 6.25
## 6 323 4001 Feminino 64 21 8 2.17
## 7 373 13022 Masculino 72 21 14 12.9
## 8 423 7473 Masculino 23 21 10 5
## 9 473 9611 Masculino 36 21 16 1.5
## 10 523 4059 Feminino 36 21 15 0.42
## # … with 644 more rows
## id salario sexo tempoempresa
## Min. : 100.0 Min. : 1501 Feminino :296 Min. : 12.00
## 1st Qu.: 731.2 1st Qu.: 5220 Masculino:358 1st Qu.: 70.00
## Median : 890.5 Median : 6300 Median : 81.00
## Mean : 875.8 Mean : 7427 Mean : 83.93
## 3rd Qu.:1030.8 3rd Qu.: 8397 3rd Qu.: 92.00
## Max. :1135.0 Max. :31992 Max. :252.00
## idade escolaridade experiencia
## Min. :18.00 Min. : 7.00 Min. : 0.00
## 1st Qu.:27.00 1st Qu.:12.00 1st Qu.: 2.17
## Median :31.00 Median :12.50 Median : 5.71
## Mean :34.33 Mean :13.22 Mean : 9.04
## 3rd Qu.:41.00 3rd Qu.:15.00 3rd Qu.:13.00
## Max. :65.00 Max. :21.00 Max. :39.67
## Classes 'tbl_df', 'tbl' and 'data.frame': 654 obs. of 7 variables:
## $ id : num 100 123 173 223 273 323 373 423 473 523 ...
## $ salario : num 1501 2538 1750 5501 4000 ...
## $ sexo : Factor w/ 2 levels "Feminino","Masculino": 2 1 1 1 1 1 2 2 2 1 ...
## $ tempoempresa: num 24 23 72 25 22 64 72 23 36 36 ...
## $ idade : num 18 18 20 20 21 21 21 21 21 21 ...
## $ escolaridade: num 12 11 12 7 8 8 14 10 16 15 ...
## $ experiencia : num 13 5.25 4.42 1.67 6.25 ...
Dataset com 6 variaveis, dentre elas a variável “salario” indica o valor de salario por cada funcionário - salario: Indica o valor recebido de salario - sexo: Indica o genero masculino (2) feminino (1) - tempoempresa: Indica o tempo de empresa de cada funcionário; - idade: Indica a idade de cada funcionário; - escolaridade: Indica o grau de escolaridade de cada funcionário; - experiencia: Indica o grau de experiência de cada funcionário;
Analisando a consistencia da amostra em relação a dados incompletos ou faltantes:
Skim summary statistics
n obs: 654
n variables: 7
Variable type: factor
| variable | missing | complete | n | n_unique | top_counts | ordered |
|---|---|---|---|---|---|---|
| sexo | 0 | 654 | 654 | 2 | Mas: 358, Fem: 296, NA: 0 | FALSE |
Variable type: numeric
| variable | missing | complete | n | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|---|
| escolaridade | 0 | 654 | 654 | 13.22 | 2.83 | 7 | 12 | 12.5 | 15 | 21 | ▂▁▇▂▅▃▁▁ |
| experiencia | 0 | 654 | 654 | 9.04 | 8.84 | 0 | 2.17 | 5.71 | 13 | 39.67 | ▇▃▃▁▁▁▁▁ |
| id | 0 | 654 | 654 | 875.85 | 174.6 | 100 | 731.25 | 890.5 | 1030.75 | 1135 | ▁▁▁▁▇▆▆▇ |
| idade | 0 | 654 | 654 | 34.33 | 10.08 | 18 | 27 | 31 | 41 | 65 | ▁▇▅▂▂▂▁▁ |
| salario | 0 | 654 | 654 | 7427.31 | 3737.18 | 1501 | 5220 | 6300 | 8397 | 31992 | ▃▇▂▁▁▁▁▁ |
| tempoempresa | 0 | 654 | 654 | 83.93 | 30.18 | 12 | 70 | 81 | 92 | 252 | ▁▃▇▁▁▁▁▁ |
Outliers são observações que apresentam uma grande diferenciação ou inconsistencias em relação aos demais. Para isso usamos analise graficas com sobreposição de histograma x distribuição normal e delimitacão de linha de corte com boxplot.
hist.default <- function(x,
breaks = "Sturges",
freq = NULL,
include.lowest = TRUE,
normalcurve = TRUE,
right = TRUE,
density = NULL,
angle = 45,
col = NULL,
border = NULL,
main = paste("Histogram of", xname),
ylim = NULL,
xlab = xname,
ylab = NULL,
axes = TRUE,
plot = TRUE,
labels = FALSE,
warn.unused = TRUE,
...) {
xname <- paste(deparse(substitute(x), 500), collapse = "\n")
suppressWarnings(
h <- graphics::hist.default(
x = x,
breaks = breaks,
freq = freq,
include.lowest = include.lowest,
right = right,
density = density,
angle = angle,
col = col,
border = border,
main = main,
ylim = ylim,
xlab = xlab,
ylab = ylab,
axes = axes,
plot = plot,
labels = labels,
warn.unused = warn.unused,
...
)
)
if (normalcurve == TRUE & plot == TRUE) {
x <- x[!is.na(x)]
xfit <- seq(min(x), max(x), length = 40)
yfit <- dnorm(xfit, mean = mean(x), sd = sd(x))
if (isTRUE(freq) | (is.null(freq) & is.null(density))) {
yfit <- yfit * diff(h$mids[1:2]) * length(x)
}
lines(xfit, yfit, col = "black", lwd = 2)
}
if (plot == TRUE) {
invisible(h)
} else {
h
}
}
plotaGraficos <- function(fsalario, label){
par(mfrow = c(1,2))
hist(fsalario, main = paste("Histograma de ",label), xlab = label, ylab="Frequência")
abline(v = mean(fsalario) - 2 * sd(fsalario), col = "red")
abline(v = mean(fsalario) + 2 * sd(fsalario), col = "red")
boxplot(fsalario)
}
plotaGraficos(salarios$salario, "salario")Pelo boxplot é possível visualizar que há grupos distintos de salários, mas também é possível notar que neste, existem observações com valores muito distantes dos agrupamentos no gráfico e consideramos estas possíveis outliers, sendo assim, serão removidos para que não interfiram no resultado da análise e dos algoritmos
Aqui vemos uma diminuição nas entradas do dataset após remoção de outliers
## id salario sexo tempoempresa
## Min. : 100 Min. : 1501 Feminino :296 Min. : 12.00
## 1st Qu.: 731 1st Qu.: 5220 Masculino:357 1st Qu.: 70.00
## Median : 891 Median : 6300 Median : 81.00
## Mean : 876 Mean : 7390 Mean : 83.75
## 3rd Qu.:1031 3rd Qu.: 8388 3rd Qu.: 92.00
## Max. :1135 Max. :25330 Max. :252.00
## idade escolaridade experiencia
## Min. :18.00 Min. : 7.00 Min. : 0.000
## 1st Qu.:27.00 1st Qu.:12.00 1st Qu.: 2.170
## Median :31.00 Median :12.00 Median : 5.670
## Mean :34.31 Mean :13.21 Mean : 9.029
## 3rd Qu.:41.00 3rd Qu.:15.00 3rd Qu.:13.000
## Max. :65.00 Max. :21.00 Max. :39.670
## Classes 'tbl_df', 'tbl' and 'data.frame': 653 obs. of 7 variables:
## $ id : num 100 123 173 223 273 323 373 423 473 523 ...
## $ salario : num 1501 2538 1750 5501 4000 ...
## $ sexo : Factor w/ 2 levels "Feminino","Masculino": 2 1 1 1 1 1 2 2 2 1 ...
## $ tempoempresa: num 24 23 72 25 22 64 72 23 36 36 ...
## $ idade : num 18 18 20 20 21 21 21 21 21 21 ...
## $ escolaridade: num 12 11 12 7 8 8 14 10 16 15 ...
## $ experiencia : num 13 5.25 4.42 1.67 6.25 ...
Gerando a correlação das variaveis, vai permitir o entendimento de quais carácteristicas influenciam mais no valor do salário recebido.
Vamos começar pela matriz de correlação.
Matriz de correlação mostra os valores de correlação de Pearson, que medem o grau de relação linear entre cada par de itens ou variáveis. Os valores de correlação podem cair entre -1 e +1.
matcor <- hetcor(salarios%>%select(2:7))
panel.cor <- function(x, y, digits=2, prefix ="", cex.cor,
...) {
usr <- par("usr")
on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
r <- cor(x, y , use = "pairwise.complete.obs")
txt <- format(c(r, 0.123456789), digits = digits) [1]
txt <- paste(prefix, txt, sep = "")
if (missing(cex.cor))
cex <- 0.8/strwidth(txt)
text(0.5, 0.5, txt, cex = cex * abs(r))
}
pairs(salarios%>%select(2:7), lower.panel=panel.smooth, upper.panel=panel.cor) ### Conclusão
O Valor de um salário neste estudo, apresenta correlação com a Escolaridade, tempo empresa, sexo e idade, sendo o maior influenciador a escolaridade, ainda que não seja tão forte assim.
Tendo como alvo o salario, usaremos os dados aqui presentes para levantarmos e estimarmos um salário usando 2 técnicas.
A regressão linear consiste em uma função que relaciona as variáveis que contém características do objeto de estudo a uma varíavel depente do mesmo objeto de estudo, gerando assim uma relação entre o resultado observado às suas possíveis explicações.
Usaremos o método stepwise no desenvolvimento do modelo, selecionando assim as variáveis que melhor estimem o valor do salário.
salarios_rl <- salarios%>%select(2:7)
modelo_rl <- lm(salarios_rl$salario ~ salarios_rl$sexo + salarios_rl$tempoempresa + salarios_rl$idade + salarios_rl$escolaridade + salarios_rl$experiencia);
stepwise<-step(modelo_rl,direction="both")## Start: AIC=10342.26
## salarios_rl$salario ~ salarios_rl$sexo + salarios_rl$tempoempresa +
## salarios_rl$idade + salarios_rl$escolaridade + salarios_rl$experiencia
##
## Df Sum of Sq RSS AIC
## <none> 4845278418 10342
## - salarios_rl$idade 1 60716998 4905995416 10348
## - salarios_rl$sexo 1 68565817 4913844234 10349
## - salarios_rl$experiencia 1 171651942 5016930360 10363
## - salarios_rl$tempoempresa 1 796669428 5641947846 10440
## - salarios_rl$escolaridade 1 1488625659 6333904077 10515
##
## Call:
## lm(formula = salarios_rl$salario ~ salarios_rl$sexo + salarios_rl$tempoempresa +
## salarios_rl$idade + salarios_rl$escolaridade + salarios_rl$experiencia)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7110.4 -1665.6 -487.6 969.1 11975.7
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -5773.230 667.979 -8.643 < 2e-16 ***
## salarios_rl$sexoMasculino 714.607 236.168 3.026 0.00258 **
## salarios_rl$tempoempresa 37.860 3.671 10.314 < 2e-16 ***
## salarios_rl$idade 38.558 13.542 2.847 0.00455 **
## salarios_rl$escolaridade 575.852 40.844 14.099 < 2e-16 ***
## salarios_rl$experiencia 74.273 15.514 4.788 2.09e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2737 on 647 degrees of freedom
## Multiple R-squared: 0.431, Adjusted R-squared: 0.4266
## F-statistic: 98.03 on 5 and 647 DF, p-value: < 2.2e-16
Através da sumarização do modelo podemos observar que escolaridade, tempo empresa, experiencia tem maior influencia no salario em comparação a idade e sexo, testes com menor influencia.
Com o gráfico abaixo podemos concluir que os resíduos da predição com o modelo desenvolvido que a premissa de normalidade é atendida:
qqnorm(residuals(modelo_rl), ylab="Resíduos",xlab="Quantis teóricos",main="")
qqline(residuals(modelo_rl)) Concluímos que com o modelo de regressão desenvolvido temos um erro quadrático médio de aproximadamente 2737.
## Warning in predict.lm(modelo_rl, interval = "prediction", level = 0.95): predictions on current data refer to _future_ responses
## [1] 2723.973
Árvores de Regressão são idênticas às árvores de decisão porém para variáveis escalares, na figura abaixo está a plotagem de uma árvore de regressão de 9 níveis na qual as folhas agrupam os funcionarios por salario, o split do algoritmo foi setado em 33 que é aproximadamente o valor de 5% da amostra. Com este algorimo atingimos um erro quadrático médio de aproximadamente 2737.
modelo_arvore <- rpart(salario ~ sexo + tempoempresa + idade + escolaridade + experiencia, data=salarios_rl,
cp = 0.001,minsplit = 33,maxdepth=20)
rpart.plot(modelo_arvore, type=4, extra=1, under=FALSE, clip.right.labs=TRUE,
fallen.leaves=FALSE, digits=2, varlen=-10, faclen=20,
cex=0.4, tweak=1.7,
compress=TRUE,
snip=FALSE)pred_arvore <- predict(modelo_arvore,interval = "prediction", level = 0.95)
mse_tree <- mean((salarios_rl$salario - pred_arvore)^2)
sqrt(mse_tree)## [1] 2249.997
Assim concluímos que entre os dois algoritmos apresentados o de melhor desempenho foi a Árvore de Regressão ainda que com uma diferença muito pequena entre eles.
Tendo em mente salarios maiores ou iguais à 6.000 sãos classificados com ALTOS e os inferiores à isso são classificados como BAIXOS podemos criar uma variável CATEGORIA_SALARIAL e criarmos uma nova variável no dataset e trabalharmos sobre os dados que levam a esta classificação.
salario_class <- salarios%>%
select(2:7)%>%
mutate(CATEGORIA_SALARIAL = ifelse(salario >= 6000, "ALTO", "BAIXO"))
salario_class$CATEGORIA_SALARIAL <- factor(salario_class$CATEGORIA_SALARIAL)
summary(salario_class$CATEGORIA_SALARIAL)## ALTO BAIXO
## 400 253
Plotamos alguns gráficos para entendermos a relação das variáveis com a categorização atribuída aos salários:
#comando para gerar em 4 linhas e duas colunas os plots
par (mfrow=c(1,2))
plot(salario_class$CATEGORIA_SALARIAL, salario_class$salario,ylab="salario",xlab="Categoria",col=c('red','darkgreen'))
plot(salario_class$CATEGORIA_SALARIAL, salario_class$escolaridade,ylab="escolaridade",xlab="Categoria",col=c('red','darkgreen'))plot(salario_class$CATEGORIA_SALARIAL, salario_class$tempoempresa,ylab="tempoempresa",xlab="Categoria",col=c('red','darkgreen'))
plot(salario_class$CATEGORIA_SALARIAL, salario_class$experiencia,ylab="experiencia",xlab="Categoria",col=c('red','darkgreen'))plot(salario_class$CATEGORIA_SALARIAL, salario_class$idade,ylab="idade",xlab="Categoria",col=c('red','darkgreen'))
plot(salario_class$CATEGORIA_SALARIAL, salario_class$sexo,ylab="sexo",xlab="Categoria",col=c('red','darkgreen'))Agora vamos usar o corrplot para enxergarmos as correlações.
matcor <- hetcor(salario_class)
panel.cor <- function(x, y, digits=2, prefix ="", cex.cor,
...) {
usr <- par("usr")
on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
r <- cor(x, y , use = "pairwise.complete.obs")
txt <- format(c(r, 0.123456789), digits = digits) [1]
txt <- paste(prefix, txt, sep = "")
if (missing(cex.cor))
cex <- 0.8/strwidth(txt)
text(0.5, 0.5, txt, cex = cex * abs(r))
}
pairs(salario_class, lower.panel=panel.smooth, upper.panel=panel.cor) As variáveis que apresentam os maiores graus de correção com a Categoria_salario (ALTO ou BAIXO) ainda que negativas são teor Salário, sexo e escolaridade.
A fim de categorizar os salários a partir de suas características utilizaremos as técnicas de regressão logística e árvore de decisão. Para o uso de tais técnicas dividiremos nosso dataset em 2/3 para o treinamento e 1/3 para a validação.
particao <- 2/3
set.seed(2019)
treino <- sample(1:NROW(salario_class), as.integer(particao*NROW(salario_class)))
trainData <- salario_class[treino,]
testData <- salario_class[-treino,]Com o intuito de selecionarmos as variáveis que utilizaremos na regressão logística primeiros iremos usar a árvore de decisão para identificarmos quais variáveis se apresentam como critérios de decisão.
modelo_arvore_decisao <- rpart (CATEGORIA_SALARIAL ~ sexo + tempoempresa + idade + escolaridade + experiencia, data=trainData, cp = 0.006,minsplit = 33,maxdepth=20)
rpart.plot(modelo_arvore_decisao, type=4, extra=104, under=FALSE, clip.right.labs=TRUE,
fallen.leaves=FALSE, digits=2, varlen=-3, faclen=20,
cex=0.4, tweak=1.7,
compress=TRUE,
snip=FALSE)salario_predito <- predict(modelo_arvore_decisao ,testData , type = "class")
matriz.de.confusao<-table(testData$CATEGORIA_SALARIAL, salario_predito)
matriz.de.confusao## salario_predito
## ALTO BAIXO
## ALTO 110 13
## BAIXO 34 61
diagonal <- diag(matriz.de.confusao)
perc.erro <- 1 - sum(diagonal)/sum(matriz.de.confusao)
perc.erro## [1] 0.2155963
Observamos pela matriz de confusão a assertividade do modelo e seu percentual de erro de aproximadamente 18%.
Assim como na regressão linear a regressão logística se baseia em váriáveis independentes para chegar a uma variável dependente, porém neste caso, uma variável categórica
modelo_log<-glm(CATEGORIA_SALARIAL ~ sexo + tempoempresa + idade + escolaridade + experiencia,trainData, family=binomial(link=logit))
predito<-fitted(modelo_log)
hist(predito)fx_predito <- cut(predito, breaks=c(0,0.10,0.20,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1), right=F)
plot(fx_predito , trainData$CATEGORIA_SALARIAL)Predito_teste<-predict(modelo_log, testData)
fx_predito1 <- cut(Predito_teste, breaks=c(0,0.50,1), right=F)
MC <- table(testData$CATEGORIA_SALARIAL, fx_predito1 , deparse.level = 2)
show(MC) ## fx_predito1
## testData$CATEGORIA_SALARIAL [0,0.5) [0.5,1)
## ALTO 8 4
## BAIXO 10 12
## [1] 0.4117647
Como podemos ver nos gráficos acima e também na matriz de confusão, o percentual de erro do modelo foi de aproximadamente 41%, o que nos leva a concluir que para a classificação dos salários entre ALTO e BAIXO o melhor método foi a Árvore de decisão.
Para análise salarial até agora usamos as chamadas técnicas supervisionas de análise, uma alternativa neste contexto seria fazer uma ANÁLISE DISCRIMINANTE, temos também um outro tipo de análise chamadas de não supervisionadas que iremos ver mais abaixo usando k-means.
Para análise dos grupos de salários a partir de sua características iremos utilizar três técnicas, são elas: Clusteres Hierárquicos, Componentes principais e K-means.
salarios_clusters <- salarios%>%select(2:7)
matcor <- hetcor(salarios_clusters)
panel.cor <- function(x, y, digits=2, prefix ="", cex.cor,
...) {
usr <- par("usr")
on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
r <- cor(x, y , use = "pairwise.complete.obs")
txt <- format(c(r, 0.123456789), digits = digits) [1]
txt <- paste(prefix, txt, sep = "")
if (missing(cex.cor))
cex <- 0.8/strwidth(txt)
text(0.5, 0.5, txt, cex = cex * abs(r))
}
pairs(salarios_clusters, lower.panel=panel.smooth, upper.panel=panel.cor)Esta técnica consiste no desenvolvimento de componentes de análise que representem as características dos dados sem que que sofre interferência das variáveis que possuem forte correlação entre elas, possibilitando assim um melhor desempenho dos modelos.
salarios_clusters$sexo <- as.numeric(factor(salarios_clusters$sexo));
salarios_clusters_padr <- scale(salarios_clusters)
pcacor_salarios <- prcomp(salarios_clusters_padr, scale = TRUE)
summary(pcacor_salarios)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6
## Standard deviation 1.4348 1.2084 1.0111 0.8502 0.64377 0.56716
## Proportion of Variance 0.3431 0.2434 0.1704 0.1205 0.06907 0.05361
## Cumulative Proportion 0.3431 0.5865 0.7569 0.8773 0.94639 1.00000
## PC1 PC2 PC3 PC4 PC5
## salario 0.5580932 -0.22611722 0.21665221 -0.16855201 -0.6127620
## sexo 0.3079092 -0.40515445 -0.45257615 0.66704762 0.2269786
## tempoempresa 0.3233663 0.09999327 0.76104501 0.43239973 0.2202163
## idade 0.4453966 0.48001399 -0.10474484 -0.29523464 0.5570753
## escolaridade 0.3244437 -0.58387853 -0.03175557 -0.49362117 0.3102593
## experiencia 0.4307161 0.45099297 -0.39631711 0.09403626 -0.3433867
## PC6
## salario -0.4319465
## sexo -0.1993610
## tempoempresa 0.2660476
## idade -0.4034112
## escolaridade 0.4614012
## experiencia 0.5720704
pcacor_salarios <- prcomp(salarios_clusters_padr, scale = TRUE, retx = TRUE)
CP1 <- pcacor_salarios$x[, 1]
CP2 <- pcacor_salarios$x[, 2]
CP3 <- pcacor_salarios$x[, 3]
CP4 <- pcacor_salarios$x[, 4]
CP5 <- pcacor_salarios$x[, 5]
CP6 <- pcacor_salarios$x[, 6]
par (mfrow=c(1,2))
hist(CP1)
hist(CP2)Baseado no gráfico de Variãncia x Componente percebos que por volta de 6 componentes principais a variância diminui bastante, e interpretando os componentes percebos que cada um leva em conta com um peso maior seja positivo ou negativo cerca de 2 a 3 características influenciadores no salario. Adotaremos então os componentes de 1 a 6.
Assim como o próprio nome diz esta técnica demonstra a hierarquia entre os clusters dentro de um mesmo dataset
hier_cluster<-hclust(dist(salarios_clusters_padr),method='ward.D2')
d <- dist(salarios_clusters_padr, method = "euclidean")
plot(hier_cluster, ylab='distancia', cex=0.6)
groups <- cutree(hier_cluster, k=10)
rect.hclust(hier_cluster, k=10, border="red")
groups <- cutree(hier_cluster, k=7)
rect.hclust(hier_cluster, k=7, border="blue") Nos baseando nas características dos salários encontramos 10 clusters distintos, sendo alguns dele muito menores do que os demais e outros bem abrangentes, faz parte da avaliação compararmos os clusters encontrados com os componentes principais e procurarmos semelhanças. Reduzimos então o número de clusters para 7 (em azul) para que possamos obersvar a hierarquia.
hier_cluster_pca<-hclust(dist(pca_salarios),method='ward.D2')
d <- dist(pca_salarios, method = "euclidean")
plot(hier_cluster_pca, ylab='distancia', cex=0.6)
groups <- cutree(hier_cluster_pca, k=10)
rect.hclust(hier_cluster_pca, k=10, border="red")
groups <- cutree(hier_cluster_pca, k=7)
rect.hclust(hier_cluster_pca, k=7, border="blue") A diferença entre os clusters sa da pois os componentes sofrem com alta correlação entre as variaveis, essa diferença se mantem, mesmo diminuindo os cluster no grafico acima.
É uma técnica não hierárquica que consiste na formação de clusters que agrupem observações a partir de um ponto central baseado na distância da observação ao ponto central, ao fim do k-means as observações estarão clusterizadas em torno do centróido ao qual tem a menor distância.
wss <- (nrow(salarios_clusters_padr)-1)*sum(apply(salarios_clusters_padr,2,var))
for (i in 2:100) wss[i] <- sum(kmeans(salarios_clusters_padr,
centers=i, iter.max = 50)$withinss)
plot(1:100, wss, type="b", xlab="Número de clusters") Analisando o gráfico acima podemos verificar que com cerca 90 clusters teremos poucas diferenças entre observações que indiquem a existe de um novo cluster com características muito específicas.
set.seed(2019)
output_cluster<-kmeans(salarios_clusters_padr,90, iter = 50)
cluster_salario<-output_cluster$cluster
table (cluster_salario)## cluster_salario
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## 18 5 6 6 9 5 3 17 7 3 3 6 2 6 8 15 3 1 16 2 14 15 3 7 5
## 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
## 6 12 7 8 9 10 10 3 10 5 10 3 9 3 5 5 3 17 10 4 3 3 4 4 3
## 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
## 27 8 11 4 5 6 2 5 4 14 3 5 7 6 19 11 2 3 11 3 11 3 8 5 8
## 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
## 4 6 19 13 9 11 5 3 10 5 6 2 6 11 1
clusplot(salarios_clusters_padr, output_cluster$cluster, color=TRUE, shade=TRUE,
labels=2, lines=0 , cex=0.75)wss <- (nrow(pca_salarios)-1)*sum(apply(pca_salarios,2,var))
for (i in 2:100) wss[i] <- sum(kmeans(pca_salarios,
centers=i, iter.max = 50)$withinss)
plot(1:100, wss, type="b", xlab="Número de clusters") Podemos observar que executando o k-means com os componentes principais encontramos cerca 80 clusters com tamanhos diferentes dos encontrados anteriormente como podemos ver abaixo.
set.seed(2019)
output_cluster_pca<-kmeans(pca_salarios,80, iter = 50)
cluster_salario_pca<-output_cluster_pca$cluster
table (cluster_salario_pca)## cluster_salario_pca
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## 10 5 2 6 10 12 10 20 9 3 5 14 4 3 8 17 3 5 6 5 5 16 2 4 11
## 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
## 8 12 14 8 13 6 10 4 11 13 14 6 9 6 7 7 6 19 10 7 6 3 4 4 3
## 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
## 28 4 19 4 5 11 2 6 4 13 3 5 10 7 9 12 2 3 10 3 11 5 15 5 5
## 76 77 78 79 80
## 4 6 21 7 9
Concluímos que utilizando os componentes principais teremos um número menor de clusters porém com características que possibilitam uma melhor visualização desses agrupamentos.
Analisando o gráfico acima podemos verificar que com cerca 90 clusters teremos poucas diferenças entre observações que indiquem a existe de um novo cluster com características muito específicas.